home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
qbsnip.zip
/
SCRLFILE.BAS
< prev
next >
Wrap
BASIC Source File
|
1997-06-02
|
4KB
|
180 lines
'From: cadwright@aol.com (CadWright)
'Newsgroups: comp.lang.basic.misc
'Date: 1 Jun 1997 11:24:06 GMT
'Here's a scroll through file list routine which I've chopped
'out of one of my proggies. I don't have time to add drive
'and directory support, maybe someone else can add
'it....
'BTW, some lines may wrap and the TAB formatting may
'be a bit screwy :)
'Craig Wright
'$INCLUDE: 'qb.bi'
DEFINT A-Z
DECLARE FUNCTION Dir$ (FileSpec$)
DECLARE SUB ShowAllFiles ()
DECLARE SUB ShowOneFile (ForeGround%, BackGround%)
'maximum files to be displayed on screen, for text mode 80x25 this will be 25
CONST FilesDisplayed = 16
'TopRow (0 to 24) and LeftColumn (1 to 68) of virtual window to display files
'in - TopRow+FilesDisplayed must be <25
CONST TopRow = 1, LeftCol = 5
'holds the file list, 512 entries, increase it for more
DIM SHARED FileList(512) AS STRING * 12
COMMON SHARED CurrentFile, BarPosition, MaxFiles
'********* code starts
'create blue background around file list window
COLOR 7, 0: CLS
VIEW PRINT 1 TO FilesDisplayed + 2
COLOR 0, 1: CLS 2
VIEW PRINT: COLOR 7, 0
'total files in directory
MaxFiles = 0
'first call to get all files in directory
FileFound$ = Dir$("*.*")
IF LEN(FileFound$) THEN
'found valid files so get rest of files in dir
DO
IF LEN(FileFound$) THEN
'found a file, increment counter and stick in array
MaxFiles = MaxFiles + 1
FileList(MaxFiles) = FileFound$
IF MaxFiles >= UBOUND(FileList) THEN EXIT DO 'exceeds file list
ELSE
EXIT DO 'no more files
END IF
FileFound$ = Dir$("")
LOOP
END IF
CurrentFile = 1 'set to first file in list
BarPosition = 0 'force screen update on first time through
'********* main scroll through file loop
DO
'check array limits
IF CurrentFile < 1 THEN
CurrentFile = 1
BarPosition = 1
END IF
IF CurrentFile > MaxFiles THEN
CurrentFile = MaxFiles
BarPosition = BarPosition - 1
END IF
'check file window limits
IF BarPosition < 1 THEN
BarPosition = 1
ShowAllFiles
END IF
IF BarPosition > FilesDisplayed THEN
BarPosition = FilesDisplayed
'may not be enough files to fill the file window
IF BarPosition > MaxFiles THEN BarPosition = MaxFiles
ShowAllFiles
END IF
ShowOneFile 0, 7 'hilight current file
DO 'get users key press..duhhh !
z$ = INKEY$
LOOP UNTIL z$ > ""
ShowOneFile 7, 0 'display file normally
SELECT CASE RIGHT$(z$, 1)
CASE CHR$(72) 'up
CurrentFile = CurrentFile - 1 'actual file in list
BarPosition = BarPosition - 1 'bar position in file window
CASE CHR$(80) 'down
CurrentFile = CurrentFile + 1
BarPosition = BarPosition + 1
CASE CHR$(13) 'return
LOCATE 23, 1: PRINT "File selected : "; FileList(CurrentFile)
END
END SELECT
LOOP
DEFSNG A-Z
FUNCTION Dir$ (FileSpec$) STATIC
DIM DTA AS STRING * 44, Regs AS RegTypeX
Regs.ax = &H1A00
Regs.dx = VARPTR(DTA)
Regs.ds = -1
INTERRUPTX &H21, Regs, Regs
IF LEN(FileSpec$) THEN
'first time through
FileA$ = FileSpec$ + CHR$(0)
Regs.ax = &H4E00
Regs.cx = 0
Regs.dx = SADD(FileA$)
Regs.ds = -1
ELSE
'no FileSpec$ so find next file
Regs.ax = &H4F00
END IF
INTERRUPTX &H21, Regs, Regs
IF Regs.flags AND 1 THEN
'no files found - return nothing
Dir$ = ""
ELSE
'get file found and return file name
Null = INSTR(31, DTA, CHR$(0))
Dir$ = MID$(DTA, 31, Null - 30)
END IF
END FUNCTION
DEFINT A-Z
SUB ShowAllFiles
'fills up the file window
start = 1 + CurrentFile - BarPosition
FOR i = start TO start + FilesDisplayed - 1
IF i > MaxFiles THEN
'if not enough files to fill up the file window then
'fill up with empty entries
FOR b = i - CurrentFile + BarPosition TO FilesDisplayed
LOCATE TopRow + b - CurrentFile + BarPosition, LeftCol:
PRINT SPACE$(LEN(FileList(1)))
NEXT
EXIT FOR
END IF
LOCATE TopRow + i - CurrentFile + BarPosition, LeftCol:
PRINT FileList(i)
NEXT
END SUB
SUB ShowOneFile (ForeGround%, BackGround%)
'refreshes a single file in the file window
COLOR ForeGround%, BackGround%
LOCATE TopRow + BarPosition, LeftCol: PRINT FileList(CurrentFile)
END SUB